MacTech 1 to 12/MacTech-vol-1-12.toast/Source/Peter Lewis (TCPExample)/PNL Libraries/MyTransport.p

Text File | 1996-01-11 | 51.1 KB | 1,987 lines | [TEXT/CWIE]

unit MyTransport;

interface

    uses
        Types, OpenTransport, TCPTypes, TCPUtils;

    var
        have_OT:Boolean;

    const
        couldNotGetRequestedPortErr = -99;

    const
        kMyStreamClosingErr = connectionClosingErr;

    type
        TransportDeferredTaskCookie = longint;
        TransportDeferredTaskProcPtr = ProcPtr; { procedure(arg:ptr) }
        TransportRef = ^integer;
        TransportUDPRef = ^point;

    type
        IPAddrArray = array[1..1000] of IPAddr;
        IPAddrArrayPtr = ^IPAddrArray;

    type
        MemoryReleasedProc = procedure (tref: TransportRef; result: OTResult; cookie: univ Ptr);

    var
        hack_MemoryReleasedProc: MemoryReleasedProc;
{ * means Interupt-safe }

    procedure StartupTransport;
    procedure ConfigureTransport(allow_OT: Boolean);

    function OpenTransportSystem:OSStatus;
    procedure CloseTransportSystem;

    function TransportUDPOpenPort(var tref: TransportUDPRef; var localport: integer; buffer_size:longint): OSStatus;
    procedure TransportUDPDestroy (var tref: TransportUDPRef);
    function TransportUDPDatagramsAvailable (tref: TransportUDPRef): longint;
    function TransportUDPRead (tref: TransportUDPRef; var remoteIP: longint; var remoteport: integer;
                                    var datap: ptr; var datalen: integer): OSStatus;
    function TransportUDPReturnBuffer (tref: TransportUDPRef; datap: ptr): OSStatus;
    function TransportUDPWrite (tref: TransportUDPRef; remoteIP: longint; remoteport: integer;
                                    datap: ptr; datalen: integer; checksum: boolean): OSStatus;

    function TransportListen(var token:Ptr; localport:integer; listeners:integer; buffer_size:longint):OSStatus;
    function TransportGetListenerConnection(token:Ptr; var tref:TransportRef):OSStatus;
    procedure TransportDestroyListener(var token:Ptr);

    function TransportOpenActiveConnection(var tref:TransportRef; dest:Str255; localport:integer; buffer_size:longint): OSStatus;
    function TransportOpenPassiveConnection(var tref:TransportRef; var localport:integer; buffer_size:longint): OSStatus;
    procedure TransportGetOpenResult(tref:TransportRef; var result: OSStatus); { * }

    procedure TransportDestroy(var tref:TransportRef);

    function TransportGetConnectionState (tref:TransportRef): TCPStateType;
    function TransportGetConnectionStateInteruptSafe (tref:TransportRef): TCPStateType; { * }
        { Note: May not change until idle time }
    function TransportGetPorts(tref:TransportRef; var localip: IPAddr; var localport: integer; var remoteip: longint; var remoteport: integer): OSStatus;
    procedure TransportSendClose(tref:TransportRef);

    function TransportHandleTransfers(tref:TransportRef): OSStatus;

    function TransportHandleReceives(tref:TransportRef): OSStatus;
    function TransportReceive(tref:TransportRef; buf: Ptr; len:longint; var count:longint): OSStatus;
    function TransportCharsAvailable(tref:TransportRef): longint;

    function TransportHandleSends(tref:TransportRef): OSStatus;
    function TransportSend(tref:TransportRef; buf: Ptr; len:longint): OSStatus;

    procedure TransportLowGetStreamPtr(tref:TransportRef; var stream: StreamPtr);
    procedure TransportLowGetEndpointRef(tref:TransportRef; var ep: EndpointRef);
    function TransportLowSetOTAckSends(tref:TransportRef; handler: MemoryReleasedProc): OSStatus;

    function TransportGetMyIPAddr(var ip:IPAddr): OSStatus;

    function TransportCreateDeferredTask(proc: OTProcessProcPtr; arg: UNIV Ptr): TransportDeferredTaskCookie;
    procedure ScheduleDeferredTask(cookie:TransportDeferredTaskCookie); { * }
    procedure DestroyDeferredTaskCookie(cookie:TransportDeferredTaskCookie);

    procedure TransportEnterInterrupt;
    procedure TransportLeaveInterrupt;

    function TransportNameToAddr(name: Str255; var token: Ptr): OSStatus;
    procedure TransportGetNameToAddrResult(var token: Ptr; var result: OSStatus; name:StringPtr; addrs:IPAddrArrayPtr; len:integer); { * }

    function TransportAddrToName(addr: IPAddr; var token: Ptr): OSStatus;
    procedure TransportGetAddrToNameResult(var token: Ptr; var result: OSStatus; var name:Str255); { * }

    procedure TransportAbortDNR(var token: Ptr);

    function StringToIPAddr (s: Str255; var addr: longInt): boolean;
    procedure IPAddrToString (ip: longInt; var addrStr: Str255);
    function IPAddrToStr (ip: longInt): Str255;
    procedure IPAddrPortToString (ip: longInt; port: integer; var addrStr: Str255);
    function IPAddrPortToStr (ip: longInt; port: integer): Str255;

implementation

    uses
        Events, TextUtils, Processes, OSUtils,Memory,
        OpenTptInternet, GestaltEqu, Devices, CodeFragments, MixedMode,
        MyCStrings, MyAssertions, DNR, MyStrings, MyMathUtils, MyGrowZones, MyTypes,
        MyUtils, MyMemory, MyCallProc, QLowLevel, PreserveA5, MyStartup;

    const
        use_OT_tasks = false;

    type
        TransportUDPRecord = record
            case boolean of
            false:(
                stream: StreamPtr;
                stream_buffer: Ptr;
                outstanding_packets: longint;
            )
            true:(
                ep: EndpointRef;
                received_packets, read_packets: longint;
            )
        end;
        TransportUDPRecordPtr = ^TransportUDPRecord;

    type
        TransportRecordPtr = ^TransportRecord;
        TransportRecord = record
            next: TransportRecordPtr;
            input_handle: Handle;
            output_handle: Handle;
            sending_handle: Handle;
            send_error, receive_error: OSStatus;
            open_result: OSStatus;
            started_opening: Boolean;
            handle_receives, handle_sends: Boolean;
            do_send_close: Boolean;
            case boolean of
            false:(
                remote_port:integer;
                local_port:integer;
                stream:StreamPtr;
                stream_buffer:Ptr;
                open_cb, close_cb, send_cb:TCPControlBlock;
                send_wds: wdsType;
                dnr_token:Ptr;
                tstate:TCPStateType;
            )
            true:(
                ep: EndpointRef;
                rcvCall, sndCall: TCall;
                rcvsin: InetAddress;
                sndsin: DNSAddress;
                waiting_for_connect: Boolean;
                connect_received: Boolean;
                accept_received: Boolean;
                passcon_received: Boolean;
                wake_process:ProcessSerialNumber;
                disconnect_received: Boolean;
                getprotaddr_result: OSStatus;
                connect_result:OSStatus;
                accept_result:OSStatus;
                passcon_result:OSStatus;
                MemoryReleasedHandler: MemoryReleasedProc;
            )
        end;

    type
        MyDeferredTask = record
            dt:DeferredTask;
            fired:Boolean;
            completion:UniversalProcPtr;
            real_arg:longint;
        end;
        MyDeferredTaskPtr = ^MyDeferredTask;

    type
        XInetHostInfo = record
            host:InetHostInfo;
            result:OSStatus;
        end;
        XInetHostInfoPtr = ^XInetHostInfo;
        TDNRRecordPtr = ^TDNRRecord;
        TDNRRecord = record
            next:TDNRRecordPtr;
            kind: (TK_NameToAddr, TK_AddrToName);
            dead: Boolean;
            case boolean of
                true:(
                    dr:DNRRecord;
                    canonical_name: Str255;
                );
                false:(
                    xhost:XInetHostInfo; { Warning InetHostInfo must *start* with an InetDomainName! }
                );
        end;

    var
        transports:QHdr;
        gMyDeferredTaskHandlerProc : UniversalProcPtr;
        tcp_is_open:Boolean;
        is_ref:InetSvcRef;
        is_result: OTResult;
        dnrs:QHdr;

    procedure InternetServicesHandler(context:Ptr; event: OTEventCode; result: OTResult; cookie: XInetHostInfoPtr);
    begin
        context := context; { UNUSED! }
        case event of
            T_OPENCOMPLETE: begin
                is_ref := InetSvcRef(cookie);
                is_result := result;
            end;
            T_DNRSTRINGTOADDRCOMPLETE, T_DNRADDRTONAMECOMPLETE: begin
                cookie^.result := result;
            end;
            otherwise
                ;
        end;
    end;

    function WaitForInternetServices: OSStatus;
    begin
        while is_result = inProgress do begin
        end;
        WaitForInternetServices := is_result;
    end;

    function ValidDNR(token: Ptr): Boolean;
        var
            this:TDNRRecordPtr;
    begin
        ValidDNR := false;
        this := TDNRRecordPtr(dnrs.qHead);
        while this <> nil do begin
            if Ptr(this) = token then begin
                ValidDNR := true;
                leave;
            end;
            this := this^.next;
        end;
    end;

    function TransportNameToAddr(name: Str255; var token: Ptr): OSStatus;
        var
            err: OSStatus;
            tdrp:TDNRRecordPtr;
    begin
        tdrp := nil;
        err := OpenTransportSystem;
        if err = noErr then begin
            err := MNewPtr(tdrp, SizeOf(TDNRRecord));
        end;
        if err = noErr then begin
            tdrp^.kind := TK_NameToAddr;
            tdrp^.dead := false;
            if have_OT then begin
                tdrp^.xhost.result := inProgress;
                P2C(@name);
                err := WaitForInternetServices;
                if err = noErr then begin
                    err := OTInetStringToAddress(is_ref, @name, tdrp^.xhost.host);
                end;
            end else begin
                tdrp^.canonical_name := name;
                DNRNameToAddr(name, @tdrp^.dr, nil);
                err := noErr;
            end;
        end;
        if err = noErr then begin
            Enqueue(QElemPtr(tdrp),@dnrs);
        end else begin
            MDisposePtr(tdrp);
        end;
        token := Ptr(tdrp);
        TransportNameToAddr := err;
    end;

    procedure TransportGetNameToAddrResult(var token: Ptr; var result: OSStatus; name:StringPtr; addrs:IPAddrArrayPtr; len:integer);
        var
            tdrp:TDNRRecordPtr;
            i:integer;
            junk: OSStatus;
    begin
        tdrp := TDNRRecordPtr(token);
        result := -1;
        if (tdrp <> nil) then begin
            if not ValidDNR(token) then begin
                DebugStr('Invalid DNR Token;sc');
            end else begin
                if have_OT then begin
                    result := tdrp^.xhost.result;
                    if result = noErr then begin
                        if name <> nil then begin
                            CopyC2P(@tdrp^.xhost.host.name, name^);
                        end;
                        for i := 1 to len do begin
                            addrs^[i] := 0;
                        end;
                        for i := 1 to Min(kMaxHostAddrs, len) do begin
                            addrs^[i] := tdrp^.xhost.host.addrs[i-1];
                        end;
                    end;
                end else begin
                    result := tdrp^.dr.ioResult;
                    if result = noErr then begin
                        if name <> nil then begin
                            name^ := tdrp^.canonical_name;
                        end;
                        for i := 1 to len do begin
                            addrs^[i] := 0;
                        end;
                        for i := 1 to Min(len, 4) do begin
                            addrs^[i] := tdrp^.dr.hi.addrs[i];
                        end;
                    end;
                end;
                if result <> inProgress then begin
                    junk := Dequeue(QElemPtr(tdrp),@dnrs);
                    MDisposePtr(tdrp);
                    token := nil;
                end;
            end;
        end;
    end;

    function TransportAddrToName(addr: IPAddr; var token: Ptr): OSStatus;
        var
            err: OSStatus;
            tdrp:TDNRRecordPtr;
    begin
        tdrp := nil;
        err := OpenTransportSystem;
        if err = noErr then begin
            err := MNewPtr(tdrp, SizeOf(TDNRRecord));
        end;
        if err = noErr then begin
            tdrp^.kind := TK_AddrToName;
            tdrp^.dead := false;
            if have_OT then begin
                tdrp^.xhost.result := inProgress;
                err := WaitForInternetServices;
                if err = noErr then begin
                    err := OTInetAddressToName(is_ref, addr, tdrp^.xhost.host.name);
                end;
            end else begin
                DNRAddrToName(addr, @tdrp^.dr, nil);
                err := noErr;
            end;
        end;
        if err = noErr then begin
            Enqueue(QElemPtr(tdrp),@dnrs);
        end else begin
            MDisposePtr(tdrp);
        end;
        token := Ptr(tdrp);
        TransportAddrToName := err;
    end;

    procedure TransportGetAddrToNameResult(var token: Ptr; var result: OSStatus; var name:Str255);
        var
            tdrp:TDNRRecordPtr;
            junk: OSStatus;
    begin
        tdrp := TDNRRecordPtr(token);
        result := -1;
        if tdrp <> nil then begin
            if not ValidDNR(token) then begin
                DebugStr('Invalid DNR Token;sc');
            end else begin
                if have_OT then begin
                    result := tdrp^.xhost.result;
                    if result = noErr then begin
                        CopyC2P(@tdrp^.xhost.host.name, name);
                    end;
                end else begin
                    result := tdrp^.dr.ioResult;
                    if result = noErr then begin
                        name := tdrp^.dr.name;
                    end;
                end;
                if result <> inProgress then begin
                    junk := Dequeue(QElemPtr(tdrp),@dnrs);
                    MDisposePtr(tdrp);
                    token := nil;
                end;
            end;
        end;
        if (result = noErr) & (name[length(name)] = '.') then begin
            Delete(name, length(name), 1);
        end;
    end;

    procedure TransportAbortDNR(var token: Ptr);
        var
            tdrp:TDNRRecordPtr;
    begin
        if token <> nil then begin
            if not ValidDNR(token) then begin
                DebugStr('Invalid DNR Token;sc');
            end else begin
                tdrp := TDNRRecordPtr(token);
                tdrp^.dead := true;
            end;
        end;
    end;

    procedure IdleDNR(this:TDNRRecordPtr);
        var
            result: OSStatus;
            name:Str255;
    begin
        case this^.kind of
            TK_NameToAddr: begin
                TransportGetNameToAddrResult(Ptr(this), result, nil, nil, 0);
            end;
            TK_AddrToName: begin
                TransportGetAddrToNameResult(Ptr(this), result, name);
            end;
        end;
    end;

    procedure IdleDNRs;
        var
            this, next:TDNRRecordPtr;
    begin
        this := TDNRRecordPtr(dnrs.qHead);
        while this <> nil do begin
            next := this^.next;
            if this^.dead then begin
                IdleDNR(this);
            end;
            this := next;
        end;
    end;

    function StringToIPAddr (s: Str255; var addr: longInt): boolean;
        var
            good: boolean;
        procedure Get1;
            var
                b: integer;
        begin
            if (length(s) = 0) | not (s[1] in ['0'..'9']) then begin
                good := false;
            end else begin
                b := ord(s[1]) - 48;
                s := TPCopy(s, 2, 255);
                if (s <> '') & (s[1] in ['0'..'9']) then begin
                    b := b * 10 + ord(s[1]) - 48;
                    s := TPCopy(s, 2, 255);
                end;
                if (s <> '') & (s[1] in ['0'..'9']) then begin
                    b := b * 10 + ord(s[1]) - 48;
                    s := TPCopy(s, 2, 255);
                end;
                if (s <> '') & (s[1] = '.') then begin
                    s := TPCopy(s, 2, 255);
                end;
                if b > 255 then begin
                    good := false;
                    b := 0; { avoid overflow error? }
                end;
                addr := BOR(BSL(addr, 8), b);
            end;
        end;
    begin
        good := true;
        addr := 0;
        Get1;
        Get1;
        Get1;
        Get1;
        good := good & (s = '');
        if not good then begin
            addr := 0;
        end;
        StringToIPAddr := good;
    end;

    procedure IPAddrToString (ip: longInt; var addrStr: Str255);
        function GetByte(ip: longint; bits: integer): Str255;
            var
                t:Str255;
        begin
             NumToString(band(bsr(ip, bits), $00FF), t);
             GetByte := t;
        end;
    begin
        addrStr := GetByte(ip, 24);
        addrStr := concat(addrStr, '.', GetByte(ip, 16));
        addrStr := concat(addrStr, '.', GetByte(ip, 8));
        addrStr := concat(addrStr, '.', GetByte(ip, 0));
    end;

    function IPAddrToStr (ip: longInt): Str255;
        var
            s: Str255;
    begin
        IPAddrToString(ip, s);
        IPAddrToStr := s;
    end;

    procedure IPAddrPortToString (ip: longInt; port: integer; var addrStr: Str255);
        var
            ns:Str255;
    begin
        NumToString(band(port, $0000FFFF), ns);
        addrStr := concat(IPAddrToStr(ip),':', ns);
    end;

    function IPAddrPortToStr (ip: longInt; port: integer): Str255;
        var
            ns:Str255;
    begin
        NumToString(band(port, $0000FFFF), ns);
        IPAddrPortToStr := concat(IPAddrToStr(ip),':', ns);
    end;

    procedure WaitForDNRCompletions;
        var
            this:TDNRRecordPtr;
    begin
        if not have_OT then begin
            while dnrs.qHead <> nil do begin
                this := TDNRRecordPtr(dnrs.qHead);
                IdleDNR(this);
            end;
        end;
    end;

{ Deferred Tasks }

    procedure MyDeferredTaskHandlerPascal(dtp: MyDeferredTaskPtr);
        var
            olda5:Ptr;
    begin
        olda5 := SetPreservedA5;
        dtp^.fired := true;
        CallPascal04(dtp^.real_arg, dtp^.completion);
        RestoreA5(olda5);
    end;

{$IFC GENERATINGPOWERPC}
    procedure MyDeferredTaskHandler(dtp: MyDeferredTaskPtr);
    begin
        MyDeferredTaskHandlerPascal(dtp);
    end;
{$ELSEC}
    procedure MyDeferredTaskHandler;
        var
            param:MyDeferredTaskPtr;
    begin
        param := MyDeferredTaskPtr(GetRegA1);
        MyDeferredTaskHandlerPascal(param);
    end;
{$ENDC}

    function TransportCreateDeferredTask(proc: OTProcessProcPtr; arg: UNIV Ptr): TransportDeferredTaskCookie;
        var
            dtp:MyDeferredTaskPtr;
            result:longint;
    begin
        result := 0;
        if have_OT & use_OT_tasks then begin
            if OpenTransportSystem = noErr then begin
                result := OTCreateDeferredTask(proc, arg);
            end;
        end else begin
            dtp := MyDeferredTaskPtr(NewPtr(SizeOf(MyDeferredTask)));
            if dtp <> nil then begin
                dtp^.dt.dtAddr := gMyDeferredTaskHandlerProc;
                dtp^.dt.dtParam := longint(dtp);
                dtp^.dt.dtReserved := 0;
                dtp^.dt.dtFlags := 0;
                dtp^.dt.qType := ord(dtQType);
                dtp^.completion := NewProc(proc, uppPascal04ProcInfo);
                dtp^.real_arg := longint(arg);
                dtp^.fired := true;
                result := TransportDeferredTaskCookie(dtp);
            end;
        end;
        TransportCreateDeferredTask := result;
    end;

    procedure ScheduleDeferredTask(cookie:TransportDeferredTaskCookie);
        var
            dummy:Boolean;
            dtp:MyDeferredTaskPtr;
    begin
        if have_OT & use_OT_tasks then begin
            dummy := OTScheduleDeferredTask(cookie);
        end else begin
            dtp := MyDeferredTaskPtr(cookie);
            if dtp^.fired then begin
                if DTInstall(DeferredTaskPtr(dtp)) = noErr then begin
                    dtp^.fired := false;
                end;
            end;
        end;
    end;

    procedure DestroyDeferredTaskCookie(cookie:TransportDeferredTaskCookie);
        var
            junk:OSStatus;
            dtp:MyDeferredTaskPtr;
    begin
        if have_OT & use_OT_tasks then begin
            junk := OTDestroyDeferredTask(cookie);
        end else begin
            dtp := MyDeferredTaskPtr(cookie);
            while not dtp^.fired do begin
                { wait til it fires since we can't abort it }
            end;
            DisposeRoutineDescriptor(dtp^.completion);
            DisposePtr(Ptr(cookie));
        end;
    end;

    procedure TransportEnterInterrupt;
    begin
        if have_OT then begin
            OTEnterInterrupt;
        end;
    end;

    procedure TransportLeaveInterrupt;
    begin
        if have_OT then begin
            OTLeaveInterrupt;
        end;
    end;

    function OpenTransportSystemOT:OSStatus;
        var
            err: OSStatus;
    begin
        err :=     InitOpenTransport;
        if err = noErr then begin
            is_result := inProgress;
            is_ref := nil;
            err := OTAsyncOpenInternetServices(OTConfigurationPtr(kDefaultInternetServicesPath), 0, @InternetServicesHandler,nil);
            if err <> noErr then begin
                is_result := err;
            end;
        end;
        OpenTransportSystemOT := err;
    end;

    procedure CloseTransportSystemOT;
        var
            junk:OSStatus;
    begin
        if is_ref <> nil then begin
            junk := OTCloseProvider(is_ref);
        end;
        CloseOpenTransport;
    end;

    function TransportGetConnectionStateOT(ep: EndpointRef):TCPStateType;
        var
            result: OTResult;
            state:TCPStateType;
    begin
        result := OTGetEndpointState(ep);
        state := T_Dead;
        if result >= 0 then begin
            case result of
                T_UNINIT, T_UNBND:
                    state := T_Dead;
                T_IDLE:begin
                    state := T_Bored;
                end;
                T_INCON, T_OUTCON:
                    state := T_Opening;
                T_DATAXFER:
                    state := T_Established;
                T_OUTREL:
                    state := T_Closing;
                T_INREL:
                    state := T_PleaseClose;
                otherwise begin
                    state := T_Unknown;
                end;
            end;
        end;
        TransportGetConnectionStateOT := state;
    end;

{ MacTCP routines }

    function OpenTransportSystemMT:OSStatus;
        var
            err:OSStatus;
    begin
        err := OpenDriver('.IPP', mactcp_driver_refnum);
        if err = noErr then begin
            err := OpenResolver;
        end;
        OpenTransportSystemMT :=     err;
    end;

    procedure CloseTransportSystemMT;
    begin
        CloseResolver;
    end;

{ Generic routines }

    function OpenTransportSystem:OSStatus;
        var
            err:OSStatus;
    begin
        if tcp_is_open then begin
            err := noErr;
        end else if have_OT then begin
            err := OpenTransportSystemOT;
        end else begin
            err := OpenTransportSystemMT;
        end;
        tcp_is_open := err = noErr;
        OpenTransportSystem := err;
    end;

    procedure CloseTransportSystem;
    begin
        if tcp_is_open then begin
            if have_OT then begin
                CloseTransportSystemOT;
            end else begin
                CloseTransportSystemMT;
            end;
        end;
    end;

    function TransportGetMyIPAddr(var ip:IPAddr): OSStatus;
        var
            err: OSStatus;
            cb: IPControlBlock;
            info:InetInterfaceInfo;
    begin
        err := OpenTransportSystem;
        if err = noErr then begin
            if have_OT then begin
                err := OTInetGetInterfaceInfo(info, 0);
                ip := info.fAddress
            end else begin
                MZero(@cb, SizeOf(cb));
                cb.ioCRefNum := mactcp_driver_refnum;
                cb.csCode := TCPcsGetMyIP;
                err := PBControlSync(@cb);
                ip := cb.getmyip.ourAddress;
            end;
        end;
        TransportGetMyIPAddr := err;
    end;

{ Open }

    function CreateOTEndpoint(var ep:EndpointRef; proc:OTNotifyProcPtr; context:univ Ptr):OSErr;
        var
            err, junk: OSStatus;
            config: Str255;
            info: TEndpointInfo;
    begin
        config := 'tcp';
        P2C(@config);
        ep:=OTOpenEndpoint(OTCreateConfiguration(@config),0,info,err);
        if err = noErr then begin
            if proc <> nil then begin
                err:=OTInstallNotifier(ep, proc, context);
            end;
            if err <> noErr then begin
                junk := OTCloseProvider(ep);
            end;
        end;
        CreateOTEndpoint := err;
    end;

    procedure OTInitNetbuf(var nb:TNetbuf; buf:Ptr; len:size);
    begin
        nb.buf := buf;
        nb.len := len;
        nb.maxlen := len;
    end;

    function SetReuseAddr(ep:EndpointRef):OSErr;
        var
            optreq:TOptMgmt;
            optBuffer:record
                header:TOptionHeader;
                value:longint;
            end;
    begin
        optreq.flags := T_NEGOTIATE;
        OTInitNetbuf(optreq.opt, @optBuffer, kOTFourByteOptionSize);
        optBuffer.header.len := kOTFourByteOptionSize;
        optBuffer.header.level := INET_IP;
        optBuffer.header.optName := IP_REUSEADDR;
        optBuffer.header.status := 0;
        optBuffer.value := $01000000;
        SetReuseAddr := OTOptionManagement(ep, optreq, optreq);
    end;

    function BindOTListener(ep:EndpointRef; var localport:integer; listeners:integer):OSErr;
        var
            err:OSStatus;
            reqsin, retsin:InetAddress;
            req, ret:TBind;
    begin
        MZero(@req, sizeof(req));
        err := noErr;
        if localport <> 0 then begin
            err := SetReuseAddr(ep);
            OTInitInetAddress(reqsin, localport, 0);
            OTInitNetbuf(req.addr, @reqsin, sizeof(InetAddress));
        end else begin
            OTInitNetbuf(req.addr, nil, 0);
        end;
        req.qlen := listeners;

        MZero(@ret, sizeof(ret));
        OTInitNetbuf(ret.addr, @retsin, sizeof(InetAddress));

        if err = noErr then begin
            err := OTBind(ep, @req, @ret);
            if (localport <> 0) & (localport <> retsin.fPort) then begin
                err := couldNotGetRequestedPortErr;
            end;
            localport := retsin.fPort;
        end;

        if err = noErr then begin
            err:=OTSetAsynchronous(ep);
        end;
        BindOTListener := err;
    end;

    procedure EventHandlerOT (btp:TransportRecordPtr; event: OTEventCode; result: OTResult; cookie: univ Ptr);
        var
            junk:OSStatus;
    begin
        cookie := cookie; { UNUSED! }
        case event of
            T_OPENCOMPLETE: begin
            end;
            T_ACCEPTCOMPLETE:  begin
                btp^.accept_result := result;
                btp^.accept_received := true;
            end;
            T_PASSCON: begin
                btp^.passcon_result := result;
                btp^.passcon_received := true;
            end;
            T_CONNECT:  begin
                btp^.connect_result := result;
                btp^.connect_received := true;
                junk := OTRcvConnect(btp^.ep, btp^.rcvCall);
            end;
            T_DISCONNECT:  begin
                btp^.connect_result := result;
                btp^.disconnect_received := true;
                junk := OTRcvDisconnect( btp^.ep, nil );
            end;
            T_GETPROTADDRCOMPLETE: begin
                btp^.getprotaddr_result := result
            end;
            T_ORDREL:  begin
                junk := OTRcvOrderlyDisconnect( btp^.ep );
            end;
            T_DATA, T_GODATA: begin
                if (btp^.wake_process.highLongOfPSN <> 0) or (btp^.wake_process.lowLongOfPSN <> kNoProcess) then begin
                    junk := WakeUpProcess(btp^.wake_process);
                end;
            end;
            T_DISCONNECTCOMPLETE: begin
            end;
            T_MEMORYRELEASED: begin
                if btp^.MemoryReleasedHandler <> nil then begin
                    btp^.MemoryReleasedHandler(TransportRef(btp), result, cookie);
                end;
            end;
            otherwise
                ;
        end;
    end;

    function ValidTransport(tref:TransportRef): Boolean;
        var
            this:TransportRecordPtr;
    begin
        ValidTransport := false;
        this := TransportRecordPtr(transports.qHead);
        while this <> nil do begin
            if TransportRef(this) = tref then begin
                ValidTransport := true;
                leave;
            end;
            this := this^.next;
        end;
    end;

    procedure TransportDestroy(var tref:TransportRef);
        var
            btp:TransportRecordPtr;
            junk:OSStatus;
    begin
        btp := TransportRecordPtr(tref);
        if btp <> nil then begin
            Assert(ValidTransport(tref));
            if have_OT then begin
                if btp^.ep <> nil then begin
                    junk := OTCloseProvider(btp^.ep);
                end;
            end else begin
                if btp^.stream <> nil then begin
                    junk := MTTCPRelease(btp^.stream);
                end;
                MDisposePtr(btp^.stream_buffer);
                TransportAbortDNR(btp^.dnr_token);
            end;
            MDisposeHandle(btp^.input_handle);
            MDisposeHandle(btp^.output_handle);
            MDisposeHandle(btp^.sending_handle);
            junk:=Dequeue(QElemPtr(btp),@transports);
            MDisposePtr(btp);
            tref := nil;
        end;
    end;

    function TransportCreate(var btp:TransportRecordPtr; buffer_size:longint):OSStatus;
        var
            err:OSStatus;
            hack_mrp: MemoryReleasedProc;
    begin
        hack_mrp := hack_MemoryReleasedProc;
        hack_MemoryReleasedProc := nil;
        buffer_size := Pin(10240, buffer_size, 64512);
        btp := nil;
        err := OpenTransportSystem;
        if err = noErr then begin
            err := MNewPtr(btp, SizeOf(TransportRecord));
            if err = noErr then begin
                Enqueue(QElemPtr(btp),@transports);
                btp^.input_handle := nil;
                btp^.output_handle := nil;
                btp^.sending_handle := nil;
                if have_OT then begin
                    btp^.MemoryReleasedHandler := hack_mrp;
                    btp^.wake_process.highLongOfPSN := 0;
                    btp^.wake_process.lowLongOfPSN := kNoProcess;
                    btp^.waiting_for_connect := false;
                    btp^.connect_received := false;
                    btp^.accept_received := false;
                    btp^.passcon_received := false;
                    btp^.disconnect_received := false;
                    err := CreateOTEndpoint(btp^.ep, @EventHandlerOT, btp);
                    if (err = noErr) & (btp^.MemoryReleasedHandler <> nil) then begin
                        err := OTAckSends(btp^.ep);
                    end;
                end else begin
                    btp^.dnr_token := nil;
                    btp^.stream := nil;
                    btp^.send_cb.ioResult := noErr;
                    err := MNewPtr(btp^.stream_buffer, buffer_size);
                    if err = noErr then begin
                        err := MTTCPCreate(btp^.stream, btp^.stream_buffer, buffer_size);
                    end;
                end;
                btp^.started_opening := false;
                btp^.handle_receives := false;
                btp^.handle_sends := false;
                btp^.do_send_close := false;
                btp^.send_error := noErr;
                btp^.open_result := inProgress;
                btp^.tstate := T_Bored;
                btp^.receive_error := noErr;
                if err <> noErr then begin
                    TransportDestroy(TransportRef(btp));
                end;
            end;
        end;
        TransportCreate := err;
    end;

    function TransportHandleReceives(tref:TransportRef): OSStatus;
        var
            err, junk: OSStatus;
            btp:TransportRecordPtr;
    begin
        btp := TransportRecordPtr(tref);
        Assert(btp <> nil);
        Assert(ValidTransport(tref));
        err := noErr;
        if not btp^.handle_receives then begin
            junk := GetCurrentProcess(btp^.wake_process);
            err := MNewHandle(btp^.input_handle, 0);
            btp^.handle_receives := err = noErr;
        end;
        TransportHandleReceives := err;
    end;

    function TransportHandleSends(tref:TransportRef): OSStatus;
        var
            err, err2: OSStatus;
            btp:TransportRecordPtr;
    begin
        btp := TransportRecordPtr(tref);
        Assert(btp <> nil);
        Assert(ValidTransport(tref));
        err := noErr;
        if not btp^.handle_sends then begin
            err := MNewHandle(btp^.output_handle, 0);
            err2 := MNewHandle(btp^.sending_handle, 0);
            if err = noErr then begin
                err := err2;
            end;
            btp^.handle_sends := err = noErr;
        end;
        TransportHandleSends := err;
    end;

    function TransportHandleTransfers(tref:TransportRef): OSStatus;
        var
            err: OSStatus;
    begin
        err := TransportHandleReceives(tref);
        if err = noErr then begin
            err :=TransportHandleSends(tref);
        end;
        TransportHandleTransfers := err;
    end;

    function TransportOpenActiveConnection(var tref:TransportRef; dest:Str255; localport:integer; buffer_size:longint): OSStatus;
        var
            btp:TransportRecordPtr;
            err: OSStatus;
            portstr:Str255;
            n:longint;
    begin
        err := TransportCreate(btp, buffer_size);
        if err = noErr then begin
            if have_OT then begin
                err := BindOTListener(btp^.ep, localport, 0);
                if err = noErr then begin
                    err:=OTSetAsynchronous(btp^.ep);
                end;
                if err = noErr then begin
                    MZero(@btp^.rcvCall, sizeof(btp^.rcvCall));
                    OTInitNetbuf(btp^.rcvCall.addr, @btp^.rcvsin, sizeof(InetAddress));

                    MZero(@btp^.sndCall, sizeof(btp^.sndCall));
                    P2C(@dest);
                    OTInitNetbuf(btp^.sndCall.addr, @btp^.sndsin, OTInitDNSAddress(btp^.sndsin, @dest));

                    err := OTConnect(btp^.ep, btp^.sndCall, btp^.rcvCall);
                    if err = kOTNoDataErr then begin
                        err := noErr;
                    end;
                end;
            end else begin
                SplitBy (dest, ':', dest, portstr);
                StringToNum(portstr, n);
                btp^.remote_port := n;
                btp^.local_port := localport;
                err := TransportNameToAddr(dest, btp^.dnr_token);
            end;
            btp^.started_opening := true;
            if err <> noErr then begin
                TransportDestroy(TransportRef(btp));
            end;
        end;
        tref := TransportRef(btp);
        TransportOpenActiveConnection := err;
    end;

    function TransportOpenPassiveConnection(var tref:TransportRef; var localport:integer; buffer_size:longint): OSStatus;
        var
            btp:TransportRecordPtr;
            err:OSStatus;
    begin
        err := TransportCreate(btp, buffer_size);
        if err = noErr then begin
            if have_OT then begin
                btp^.waiting_for_connect := true;
                err := BindOTListener(btp^.ep, localport, 1);
            end else begin
                err := MTTCPPassiveOpen(btp^.open_cb, btp^.stream, localport);
            end;
            btp^.started_opening := true;
            if err <> noErr then begin
                TransportDestroy(TransportRef(btp));
            end;
        end;
        tref := TransportRef(btp);
        TransportOpenPassiveConnection := err;
    end;

    procedure TransportGetOpenResult(tref:TransportRef; var result: OSStatus);
        var
            btp:TransportRecordPtr;
    begin
        btp := TransportRecordPtr(tref);
        Assert(btp <> nil);
        Assert(ValidTransport(tref));
        result := btp^.open_result
    end;

    procedure ProcessOpen(btp:TransportRecordPtr);
        var
            addr:IPAddr;
            result: OSStatus;
    begin
        Assert(btp <> nil);
        if btp^.started_opening & (btp^.open_result = inProgress) then begin
            if have_OT then begin
                if btp^.waiting_for_connect then begin
                    MZero(@btp^.rcvCall, sizeof(btp^.rcvCall));
                    OTInitNetbuf(btp^.rcvCall.addr, @btp^.rcvsin, sizeof(InetAddress));
                    result := OTListen(btp^.ep, btp^.rcvCall);
                    if result = kOTNoDataErr then begin
                        result := inProgress;
                    end else begin
                        btp^.waiting_for_connect := false;
                        if result = noErr then begin
                            result := OTAccept(btp^.ep, btp^.ep, btp^.rcvCall);
                        end;
                    end;
                end else if btp^.disconnect_received then begin
                    result := -71;
                end else if btp^.connect_received then begin
                    result := btp^.connect_result;
                end else if btp^.accept_received then begin
                    result := btp^.accept_result;
                end else if btp^.passcon_received then begin
                    result := btp^.passcon_result;
                end else begin
                    result := inProgress;
                end;
            end else begin
                result := noErr;
                if btp^.dnr_token <> nil then begin
                    TransportGetNameToAddrResult(btp^.dnr_token, result, nil, @addr, 1);
                    if result = noErr then begin
                        result := MTTCPActiveOpen(btp^.open_cb, btp^.stream, btp^.local_port, addr, btp^.remote_port);
                    end;
                end;
                if result = noErr then begin
                    result := btp^.open_cb.ioResult;
                end;
            end;
            btp^.open_result := result;
        end;
    end;

    procedure IdleReceive(btp:TransportRecordPtr);
        var
            err: OSStatus;
            result: OTResult;
            flags:OTFlags;
            cb:TCPControlBlock;
            len, count: longint;
            space: packed array[1..2048] of byte;
    begin
        if btp^.handle_receives then begin
            len := GetHandleSize(btp^.input_handle);
            if have_OT then begin
                if len < 10240 then begin
                    result := OTRcv(btp^.ep, @space, SizeOf(space), flags);
                    if result >= 0 then begin
                        err := PtrAndHand(@space, btp^.input_handle, result);
                    end else begin
                        if (result <> kOTNoDataErr) & (result <> kOTOutStateErr) then begin
                            err := result;
                        end else begin
                            err := noErr;
                        end;
                    end;
                    if err <> noErr then begin
                        btp^.receive_error := err;
                    end;
                end;
            end else begin
                MTZeroTCPCB(cb, btp^.stream, TCPcsStatus);
                err := PBControlSync(@cb);
                if err = noErr then begin
                    count := Min(cb.status.amtUnreadData, 10240 - len);
                    if count > 0 then begin
                        err := MSetHandleSize(btp^.input_handle, len + count);
                        if err = noErr then begin
                            HLock(btp^.input_handle);
                            MTZeroTCPCB(cb, btp^.stream, TCPcsRcv);
                            cb.receive.rcvBuff := btp^.input_handle^;
                            cb.receive.rcvBuffLength := count;
                            err := PBControlSync(@cb);
                            count := cb.receive.rcvBuffLength;
                            HUnlock(btp^.input_handle);
                        end;
                        if err <> noErr then begin
                            count := 0;
                            btp^.receive_error := err;
                        end;
                        SetHandleSize(btp^.input_handle, len + count);
                    end;
                end;
            end;
        end;
    end;

    function TransportCharsAvailable(tref:TransportRef): longint;
        var
            btp:TransportRecordPtr;
    begin
        btp := TransportRecordPtr(tref);
        Assert(btp <> nil);
        Assert(ValidTransport(tref));
        Assert(btp^.handle_receives);
        TransportCharsAvailable := GetHandleSize(btp^.input_handle);
    end;

    function TransportReceive(tref:TransportRef; buf: Ptr; len:longint; var count:longint): OSStatus;
        var
            btp:TransportRecordPtr;
            err: OSStatus;
    begin
        btp := TransportRecordPtr(tref);
        Assert(btp <> nil);
        Assert(ValidTransport(tref));
        Assert(btp^.handle_receives);
        if btp^.receive_error <> noErr then begin
            err := btp^.receive_error;
            btp^.receive_error := noErr;
            count := 0;
        end else begin
            err := noErr;
            count := Min(len, GetHandleSize(btp^.input_handle));
            if count > 0 then begin
                BlockMoveData(btp^.input_handle^, buf, count);
                MMungerDelete(btp^.input_handle, 0, count);
            end;
        end;
        TransportReceive := err;
    end;

    function TransportSend(tref:TransportRef; buf: Ptr; len:longint): OSStatus;
        var
            btp:TransportRecordPtr;
            err: OSStatus;
    begin
        btp := TransportRecordPtr(tref);
        Assert(btp <> nil);
        Assert(ValidTransport(tref));
        if not btp^.handle_sends then begin
            err := -31; { I'd like to know why this actually occurs }
        end else begin
            err := PtrAndHand(buf, btp^.output_handle, len);
            if err = noErr then begin
                err := btp^.send_error;
                btp^.send_error:= noErr;
            end;
        end;
        TransportSend := err;
    end;

    procedure IdleSend(btp: TransportRecordPtr);
        procedure SwapHandles(var h1, h2:Handle);
            var
                tmph:Handle;
        begin
            tmph := h1;
            h1 := h2;
            h2 := tmph;
        end;
        var
            err: OSStatus;
            result: OTResult;
            len:longint;
    begin
        if btp^.handle_sends then begin
            len := GetHandleSize(btp^.output_handle);
            if btp^.do_send_close & (len = 0) then begin
                btp^.handle_sends := false;
                TransportSendClose(TransportRef(btp));
            end else begin
                if have_OT then begin
                    if len > 0 then begin
                        HLock(btp^.output_handle);
                        result := OTSnd(btp^.ep, btp^.output_handle^, len, 0);
                        HUnlock(btp^.output_handle);
                        if result >= 0 then begin
                            MMungerDelete(btp^.output_handle, 0, result);
                        end else if result <> kOTFlowErr then begin
                            btp^.send_error := result;
                            SetHandleSize(btp^.output_handle, 0);
                        end;
                    end;
                end else begin
                    if btp^.send_cb.ioResult <> inProgress then begin
                        HUnlock(btp^.sending_handle);
                        SetHandleSize(btp^.sending_handle, 0);
                        if btp^.send_cb.ioResult <> noErr then begin
                            btp^.send_error := btp^.send_cb.ioResult;
                            btp^.send_cb.ioResult := noErr;
                        end;
                        if len > 0 then begin
                            SwapHandles(btp^.output_handle, btp^.sending_handle);
                            HLock(btp^.sending_handle);
                            btp^.send_wds.buffer := btp^.sending_handle^;
                            btp^.send_wds.size := len;
                            btp^.send_wds.term := 0;
                            MTZeroTCPCB(btp^.send_cb, btp^.stream, TCPcsSend);
                            btp^.send_cb.send.wds := @btp^.send_wds;
                            btp^.send_cb.send.pushFlag := 1;
                            err := PBControlAsync(@btp^.send_cb);
                        end;
                    end;
                end;
            end;
        end;
    end;

    procedure TransportSendClose(tref:TransportRef);
        var
            btp:TransportRecordPtr;
            err: OSStatus;
    begin
        btp := TransportRecordPtr(tref);
        Assert(btp <> nil);
        Assert(ValidTransport(tref));
        if btp^.handle_sends then begin
            btp^.do_send_close := true;
            IdleSend(btp);
        end else begin
            if have_OT then begin
                err := OTSndOrderlyDisconnect(btp^.ep);
            end else begin
                err := MTTCPClose(btp^.close_cb, btp^.stream);
            end;
        end;
    end;

    function TransportGetConnectionStateInteruptSafe (tref:TransportRef): TCPStateType; { * }
        var
            btp:TransportRecordPtr;
            state:TCPStateType;
    begin
        btp := TransportRecordPtr(tref);
        if btp = nil then begin
            state := T_Dead;
        end else if have_OT then begin
            state := TransportGetConnectionStateOT(btp^.ep);
        end else begin
            state := btp^.tstate;
        end;
        TransportGetConnectionStateInteruptSafe := state;
    end;

    procedure IdleMacTCPConnectionState(btp:TransportRecordPtr);
    begin
        Assert(not have_OT);
        if btp^.dnr_token <> nil then begin
            btp^.tstate := T_Opening;
        end else if btp^.stream = nil then begin
            btp^.tstate := T_Dead;
        end else begin
            btp^.tstate := MTTCPState(btp^.stream);
        end;
    end;

    function TransportGetConnectionState (tref:TransportRef): TCPStateType;
        var
            btp:TransportRecordPtr;
            state:TCPStateType;
    begin
        btp := TransportRecordPtr(tref);
        if btp = nil then begin
            state := T_Dead;
        end else if have_OT then begin
            state := TransportGetConnectionStateOT(btp^.ep);
        end else begin
            btp^.tstate := MTTCPState(btp^.stream);
            state := btp^.tstate;
        end;
        TransportGetConnectionState := state;
    end;

    procedure TransportLowGetStreamPtr(tref:TransportRef; var stream: StreamPtr);
        var
            btp:TransportRecordPtr;
    begin
        btp := TransportRecordPtr(tref);
        Assert(btp <> nil);
        Assert(ValidTransport(tref));
        Assert(not have_OT);
        stream := btp^.stream;
    end;

    procedure TransportLowGetEndpointRef(tref:TransportRef; var ep: EndpointRef);
        var
            btp:TransportRecordPtr;
    begin
        btp := TransportRecordPtr(tref);
        Assert(btp <> nil);
        Assert(have_OT);
        Assert(ValidTransport(tref));
        ep := btp^.ep;
    end;

    function TransportLowSetOTAckSends(tref:TransportRef; handler: MemoryReleasedProc): OSStatus;
        var
            err: OSStatus;
            btp:TransportRecordPtr;
    begin
        btp := TransportRecordPtr(tref);
        Assert(btp <> nil);
        Assert(ValidTransport(tref));
        Assert(have_OT);
        err := noErr;
        if btp^.MemoryReleasedHandler = nil then begin
            err := OTAckSends(btp^.ep);
        end;
        if err = noErr then begin
            btp^.MemoryReleasedHandler := handler;
        end;
        TransportLowSetOTAckSends := err;
    end;

    function TransportGetPorts(tref:TransportRef; var localip: IPAddr; var localport: integer; var remoteip: longint; var remoteport: integer): OSStatus;
        var
            err: OSStatus;
            btp: TransportRecordPtr;
            cb: TCPControlBlock;
            localBind, remoteBind: TBind;
            localAddr, remoteAddr: InetAddress;
    begin
        btp := TransportRecordPtr(tref);
        Assert(btp <> nil);
        Assert(ValidTransport(tref));
        localip := 0;
        localport := 0;
        remoteip := 0;
        remoteport := 0;
        if have_OT then begin
            btp^.getprotaddr_result := inProgress;
            OTInitNetbuf(localBind.addr, @localAddr, SizeOf(localAddr));
            OTInitNetbuf(remoteBind.addr, @remoteAddr, SizeOf(remoteAddr));
            err := OTGetProtAddress(btp^.ep, localBind, remoteBind);
            if err = noErr then begin
                while btp^.getprotaddr_result = inProgress do begin
                    OTIdle;
                end;
                err := btp^.getprotaddr_result;
            end;
            if err = noErr then begin
                localip := localAddr.fHost;
                localport := localAddr.fPort;
                remoteip := remoteAddr.fHost;
                remoteport := remoteAddr.fPort;
            end;
        end else begin
            MTZeroTCPCB(cb, btp^.stream, TCPcsStatus);
            err := PBControlSync(@cb);
            if err = noErr then begin
                localip := cb.status.localhost;
                localport := cb.status.localport;
                remoteip := cb.status.remotehost;
                remoteport := cb.status.remoteport;
            end;
        end;
        TransportGetPorts := err;
    end;

    const
        max_tcp_listeners = 20;

    type
        OTSequenceArray = array[0..0] of OTSequence;
        OTSequenceArrayPtr = ^OTSequenceArray;
        OTSequenceArrayHandle = ^OTSequenceArrayPtr;

    type
        TransportListenRecord = record
            case boolean of
            false:(
                mt_buffer_size:longint;
                mt_listeners_count:integer;
                mt_listeners:array[1..max_tcp_listeners] of TransportRef;
                localport:integer;
            )
            true:(
                ep: EndpointRef;
                sequences: OTSequenceArrayHandle;
            )
        end;
        TransportListenRecordPtr = ^TransportListenRecord;

    function TransportListen(var token:Ptr; localport:integer; listeners:integer; buffer_size:longint):OSStatus;
        var
            lp:TransportListenRecordPtr;
            err, junk:OSStatus;
            i:integer;
    begin
        lp := nil;
        err := OpenTransportSystem;
        if err = noErr then begin
            err := MNewPtr(lp, SizeOf(TransportListenRecord));
            if err = noErr then begin
                if have_OT then begin
                    err := MNewHandle(lp^.sequences, 0);
                    if err = noErr then begin
                        err := CreateOTEndpoint(lp^.ep, nil, lp);
                        if err = noErr then begin
                            err := BindOTListener(lp^.ep, localport, 99);
                            if err <> noErr then begin
                                junk := OTCloseProvider(lp^.ep);
                            end;
                        end;
                        if err <> noErr then begin
                            MDisposeHandle(lp^.sequences);
                        end;
                    end;
                end else begin
                    lp^.localport := localport;
                    lp^.mt_listeners_count := listeners;
                    lp^.mt_buffer_size := buffer_size;
                    for i := 1 to lp^.mt_listeners_count do begin
                        lp^.mt_listeners[i] := nil;
                    end;
                end;
            end;
        end;
        if err <> noErr then begin
            MDisposePtr(lp);
        end;
        token := Ptr(lp);
        TransportListen := err;
    end;

    function TransportGetListenerConnectionOT(lp:TransportListenRecordPtr; var tref:TransportRef):OSStatus;
        function CountSequences: longint;
        begin
            CountSequences := GetHandleSize(Handle(lp^.sequences)) div SizeOf(OTSequence);
        end;

        procedure DelSequence(sequence: OTSequence);
            var
                i: longint;
        begin
            for i := 0 to CountSequences - 1 do begin
                if lp^.sequences^^[i] = sequence then begin
                    MMUngerDelete(Handle(lp^.sequences), i * SizeOf(OTSequence), SizeOf(OTSequence));
                    leave;
                end;
            end;
        end;
        label
            1;
        var
            err: OSStatus;
            result: OTResult;
            rcvCall:TCall;
            rcvsin:InetAddress;
            btp:TransportRecordPtr;
            discon: TDiscon;
            sequence: OTSequence;
    begin
        1:
        repeat
            MZero(@rcvCall, sizeof(rcvCall));
            OTInitNetbuf(rcvCall.addr, @rcvsin, sizeof(InetAddress));
            result := OTListen(lp^.ep, rcvCall);
            if result = noErr then begin
                sequence := rcvCall.sequence;
                result := PtrAndHand(@sequence, Handle(lp^.sequences), SizeOf(sequence));
            end else if result = kOTLookErr then begin
                MZero(@discon, sizeof(discon));
                result := OTRcvDisconnect(lp^.ep, @discon);
                if result = noErr then begin
                    DelSequence(discon.sequence);
                end;
            end;
        until result <> noErr;
        if result <> kOTNoDataErr then begin
            err := result;
        end else begin
            if CountSequences = 0 then begin
                err := inProgress;
            end else begin
                err := TransportCreate(btp, 0);
                if err = noErr then begin
                    tref := TransportRef(btp);
                    btp^.started_opening := true;
                    MZero(@rcvCall, sizeof(rcvCall));
                    rcvCall.sequence := lp^.sequences^^[0];
                    err := OTAccept(lp^.ep, btp^.ep, rcvCall);
                    if err = kOTLookErr then begin
                        TransportDestroy(tref);
                        goto 1;
                    end else begin
                        MMungerDelete(Handle(lp^.sequences), 0, SizeOf(OTSequence));
                    end;
                    if err = noErr then begin
                        err:=OTSetAsynchronous(btp^.ep);
                    end;
                    if err <> noErr then begin
                        TransportDestroy(tref);
                    end;
                end;
            end;
        end;
        TransportGetListenerConnectionOT := err;
    end;

    function TransportGetListenerConnection(token:Ptr; var tref:TransportRef):OSStatus;
        var
            err, result:OSStatus;
            lp:TransportListenRecordPtr;
            i:integer;
    begin
        lp := TransportListenRecordPtr(token);
        if lp = nil then begin
            err := -28;
        end else begin
            err := inProgress;
            if have_OT then begin
                err := TransportGetListenerConnectionOT(lp, tref);
            end else begin
                for i := 1 to lp^.mt_listeners_count do begin
                    if (lp^.mt_listeners[i] = nil) & EnoughSpace(100000, 70000) then begin
                        err := TransportOpenPassiveConnection(lp^.mt_listeners[i], lp^.localport, lp^.mt_buffer_size);
                        leave; { only create one listener, that allows the listeners to be shared a bit better }
                    end;
                end;

                err := inProgress;
                for i := 1 to lp^.mt_listeners_count do begin
                    if (lp^.mt_listeners[i] <> nil) then begin
                        Assert(ValidTransport(lp^.mt_listeners[i]));
                        TransportGetOpenResult(lp^.mt_listeners[i], result);
                        case result of
                            inProgress: begin
                            end;
                            noErr:begin
                                tref := lp^.mt_listeners[i];
                                lp^.mt_listeners[i] := nil;
                                err := noErr;
                                leave;
                            end;
                            otherwise begin
                                TransportDestroy(lp^.mt_listeners[i]);
                            end;
                        end;
                    end;
                end;
            end;
        end;
        if err <> noErr then begin
            tref := nil;
        end;
        TransportGetListenerConnection := err;
    end;

    procedure TransportDestroyListener(var token:Ptr);
        var
            junk:OSStatus;
            lp:TransportListenRecordPtr;
            i:integer;
    begin
        lp := TransportListenRecordPtr(token);
        if lp <> nil then begin
            if have_OT then begin
                junk := OTCloseProvider(lp^.ep);
                MDisposeHandle(lp^.sequences);
            end else begin
                for i := 1 to lp^.mt_listeners_count do begin
                    TransportDestroy(lp^.mt_listeners[i]);
                end;
                lp^.mt_listeners_count := 0;
            end;
            MDisposePtr(token);
        end;
    end;

    function CreateOTUDPEndpoint(var ep:EndpointRef; proc:OTNotifyProcPtr; var localport: integer; context:univ Ptr):OSErr;
        var
            err, junk: OSStatus;
            config: Str255;
            info: TEndpointInfo;
            reqsin, retsin:InetAddress;
            req, ret:TBind;
    begin
        config := 'udp';
        P2C(@config);
        ep:=OTOpenEndpoint(OTCreateConfiguration(@config),0,info,err);
        if (err = noErr) & (proc <> nil) then begin
            err:=OTInstallNotifier(ep, proc, context);
        end;

        if err = noErr then begin
            if localport <> 0 then begin
                OTInitInetAddress(reqsin, localport, 0);
                OTInitNetbuf(req.addr, @reqsin, sizeof(InetAddress));
            end else begin
                OTInitNetbuf(req.addr, nil, 0);
            end;
            req.qlen := 1;

            MZero(@ret, sizeof(ret));
            OTInitNetbuf(ret.addr, @retsin, sizeof(InetAddress));
            err := OTBind(ep, @req, @ret);
            localport := retsin.fPort;
        end;
        if (err = noErr) & (localport <> 0) & (localport <> retsin.fPort) then begin
            err := couldNotGetRequestedPortErr;
        end;
        if err = noErr then begin
            err:=OTSetNonBlocking(ep);
        end;
        if err <> noErr then begin
            junk := OTCloseProvider(ep);
        end;
        CreateOTUDPEndpoint := err;
    end;

    procedure UDPEventHandlerOT (tup: TransportUDPRecordPtr; event: OTEventCode; result: OTResult; cookie: univ Ptr);
    begin
        cookie := cookie; { UNUSED! }
        result := result; { Unused! }
        case event of
            T_DATA: begin
                Inc(tup^.received_packets);
            end;
            otherwise
                ;
        end;
    end;

    function TransportUDPOpenPort(var tref: TransportUDPRef; var localport: integer; buffer_size:longint): OSStatus;
        var
            err:OSStatus;
            tup: TransportUDPRecordPtr;
    begin
        buffer_size := Pin(10240, buffer_size, 64512);
        tup := nil;
        err := OpenTransportSystem;
        if err = noErr then begin
            err := MNewPtr(tup, SizeOf(TransportUDPRecord));
            if err = noErr then begin
                if have_OT then begin
                    tup^.received_packets := 0;
                    tup^.read_packets := 0;
                    err := CreateOTUDPEndpoint(tup^.ep, @UDPEventHandlerOT, localport, tup);
                end else begin
                    tup^.stream := nil;
                    err := MNewPtr(tup^.stream_buffer, buffer_size);
                    if err = noErr then begin
                        err := MTUDPCreate(tup^.stream, localport, @tup^.outstanding_packets, tup^.stream_buffer, buffer_size);
                    end;
                end;
                if err <> noErr then begin
                    TransportUDPDestroy(TransportUDPRef(tup));
                end;
            end;
        end;
        tref := TransportUDPRef(tup);
        TransportUDPOpenPort := err;
    end;

    procedure TransportUDPDestroy (var tref: TransportUDPRef);
        var
            err, junk: OSStatus;
            tup: TransportUDPRecordPtr;
    begin
        err := noErr;
        tup := TransportUDPRecordPtr(tref);
        if tup <> nil then begin
            if have_OT then begin
                if tup^.ep <> nil then begin
                    junk := OTCloseProvider(tup^.ep);
                end;
            end else begin
                if tup^.stream <> nil then begin
                    err := MTUDPRelease(tup^.stream);
                end;
                MDisposePtr(tup^.stream_buffer);
            end;
            MDisposePtr(tup);
            tref := nil;
        end;
    end;

    const
        max_udp_datalen = 2048;

    function TransportUDPDatagramsAvailable (tref: TransportUDPRef): longint;
        var
            tup: TransportUDPRecordPtr;
    begin
        tup := TransportUDPRecordPtr(tref);
        Assert(tup <> nil);
        if have_OT then begin
            TransportUDPDatagramsAvailable := tup^.received_packets - tup^.read_packets;
        end else begin
            TransportUDPDatagramsAvailable := tup^.outstanding_packets;
        end;
    end;

    function TransportUDPRead (tref: TransportUDPRef; var remoteIP: longint; var remoteport: integer;
                                    var datap: ptr; var datalen: integer): OSStatus;
        var
            err:OSStatus;
            tup: TransportUDPRecordPtr;
            udata:TUnitData;
            flags: OTFlags;
            srcsin: InetAddress;
            tmp_packets: longint;
    begin
        tup := TransportUDPRecordPtr(tref);
        Assert(tup <> nil);
        if have_OT then begin
            err := MNewPtr(datap, max_udp_datalen);
            if err = noErr then begin
                MZero(@udata, SizeOf(udata));
                OTInitNetbuf(udata.addr, @srcsin, SizeOf(srcsin));
                OTInitNetbuf(udata.udata, datap, max_udp_datalen);
                tmp_packets := tup^.received_packets;
                err := OTRcvUData(tup^.ep,udata, flags);
                if err = noErr then begin
                    Inc(tup^.read_packets);
                    datalen := udata.udata.len;
                    remoteIP := srcsin.fHost;
                    remoteport := srcsin.fPort;
                end;
                if (err = kOTNoDataErr) then begin
                    tup^.read_packets := tmp_packets;
                end;
            end;
            if err <> noErr then begin
                MDisposePtr(datap);
            end;
        end else begin
            err := MTUDPRead(tup^.stream, @tup^.outstanding_packets, remoteIP, remoteport, datap, datalen);
        end;
        TransportUDPRead := err;
    end;

    function TransportUDPReturnBuffer (tref: TransportUDPRef; datap: ptr): OSStatus;
        var
            err:OSStatus;
            tup: TransportUDPRecordPtr;
    begin
        err := noErr;
        tup := TransportUDPRecordPtr(tref);
        Assert(tup <> nil);
        if tup <> nil then begin
            if have_OT then begin
                MDisposePtr(datap);
            end else begin
                err := MTUDPReturnBuffer(tup^.stream, datap);
            end;
        end;
        TransportUDPReturnBuffer := err;
    end;

    function TransportUDPWrite (tref: TransportUDPRef; remoteIP: longint; remoteport: integer;
                                    datap: ptr; datalen: integer; checksum: boolean): OSStatus;
        var
            err:OSStatus;
            tup: TransportUDPRecordPtr;
            udata:TUnitData;
            destsin: InetAddress;
    begin
        err := noErr;
        tup := TransportUDPRecordPtr(tref);
        Assert(tup <> nil);
        if tup <> nil then begin
            if have_OT then begin
                MZero(@udata, SizeOf(udata));
                OTInitInetAddress(destsin, remoteport, remoteIP);
                OTInitNetbuf(udata.addr, @destsin, SizeOf(destsin));
                OTInitNetbuf(udata.udata, datap, datalen);
                err := OTSndUData(tup^.ep,udata);
            end else begin
                err := MTUDPWrite(tup^.stream, remoteIP, remoteport, datap, datalen, checksum);
            end;
        end;
        TransportUDPWrite := err;
    end;

    procedure IdleTransports;
        var
            this, next:TransportRecordPtr;
    begin
        this := TransportRecordPtr(transports.qHead);
        while this <> nil do begin
            next := this^.next;
            ProcessOpen(this);
            if this^.open_result = noErr then begin
                IdleSend(this);
                IdleReceive(this);
            end;
            if not have_OT then begin
                IdleMacTCPConnectionState(this);
            end;
            this := next;
        end;
    end;

    procedure IdleTransport;
    begin
        IdleDNRs;
        IdleTransports;
    end;

    function HasOTLib:boolean;
    begin
{$IFC GENERATINGPOWERPC}
        HasOTLib := longint(@InitOpenTransport) <> kUnresolvedCFragSymbolAddress;
{$ELSEC}
        HasOTLib := true;
{$ENDC}
    end;

    procedure ConfigureTransport(allow_OT: Boolean);
        var
            gv:longint;
    begin
        StartupTransport;
        if not allow_OT then begin
            have_OT := false;
        end else begin
            have_OT := (Gestalt(gestaltOpenTpt, gv) = noErr) & (BAND(gv, gestaltOpenTptPresent) <> 0) & (BAND(gv, gestaltOpenTptTCPPresent) <> 0) & HasOTLib;
        end;
    end;

    function InitTransport(var msg: integer):OSStatus;
    begin
        msg := msg; { Unused }
        hack_MemoryReleasedProc := nil;
        gMyDeferredTaskHandlerProc := NewProc(@MyDeferredTaskHandler, uppDeferredTaskProcInfo);
        tcp_is_open := false;
        dnrs.qHead := nil;
        dnrs.qTail := nil;
        transports.qHead := nil;
        transports.qTail := nil;
        is_ref := nil;
        InitTransport := noErr;
    end;

    procedure FinishTransport;
    begin
        WaitForDNRCompletions;
        CloseTransportSystem;
    end;

    procedure StartupTransport;
    begin
        StartupPreserveA5;
        StartupTCPUtils;
        SetStartup(InitTransport, IdleTransport, 0, FinishTransport);
    end;

end.

    procedure Blibble;
        var
            err, junk: OSStatus;
            config: Str255;
            info: TEndpointInfo;
            ep:EndpointRef;
            cfg: OTConfigurationPtr;
    begin
        err := OpenTransportSystem;
        if err = noErr then begin
            config := 'udp';
            P2C(@config);
            cfg := OTCreateConfiguration(@config);
            ep := OTOpenEndpoint(cfg,0,info,err);
            if ep <> nil then begin
                junk := OTCloseProvider(ep);
            end;
        end;
    end;